The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/mat.vec

Text File | 1995-03-23 | 8KB | 405 lines

This file contains some programs which handle with arrays and lists.

Short decsription:
------------------

A<-->L   array to list and reverse

         This program converts an array to the corresponding list and
         viceversa, eg:

         [[ 1 2 ]          {{ 1 2 }
          [ 3 4 ]    <-->   { 3 4 }
          [ 5 6 ]           { 5 6 }}

          [ 3.5 -8 ]    <-->   { 3.5 -8 }

         The format of the list must of course "looks" like an array, say
         a list of list of numbers, each sublist with the same length.



trn      Transponse

         A generic transpose function for matrices and lists. The list must have
         the format of a n*m-matrix, but is allowed to contain any object.


         {{   'foo'    'bar' 1.234 }          {{ 'foo' << swap >> }
          { << swap >>  { }   "!"  }}  <-->    {  { }    'bar'    }
                                               {  "!"    1.234    }}


MOP      Matrix Operation

         Revised 'MOP' (Matrix OPeration): A program, which executes any
         algebraic  operation or program on every element of an 1 or 2
         dimensional array.

         usage:
         ======

         2:                <array>
         1:   <algebraic function>  or  <program>
         MOP

         2:        <name of array>
         1:   <algebraic function>  or  <program>
         MOP


         e.g.:
         =====

         2:         [[  1  2.3 ]
                     [ -3  4.4 ]
                     [  1 -1.1 ]]
         1:       'LOG(SQR(X))-3'
         MOP


         2:         [[  1  2.3 ]
                     [ -3  4.4 ]
                     [  1 -1.1 ]]
         1: << IF X 1 < THEN X DUP R->C ELSE X END >>
         MOP


         2:               '&DAT'
         1:             'INV(X)'
         MOP


         2:               '&DAT'
         1:          << X INV >>
         MOP

         The algebraic operation must have 'x' as argument. I know, this
         sucks, but calling by reference like  'MOP(INV(<array>)*3-2)'  is
         not possible (or does anybody know a way ??)
         & := the Sigma-sign

         The name 'MOP' was created by Schrulli B.  thanx ;-)



V<-->M   vector to matrix and reverse

         Converts a vector to a matrix and viceversa.

         [ -9  2.3  4 ]    <--->    [[ -9  2.3  4 ]]



M->V     matrix to vectors

         Another "OBJ->" command. It puts all vectors of a matrix to the stack:

         [[  1  2.3 ]                [  1  2.3 ]
          [ -3  4.4 ]     --->       [ -3  4.4 ]
          [  1 -1.1 ]]               [  1 -1.1 ]
                                               3


V->M     vectors to matrix

         The corresponding function to  M->V  It takes n vectors from the stack
         and builds one matrix.


         [  1  2.3 ]                [[  1  2.3 ]
         [ -3  4.4 ]      --->       [ -3  4.4 ]
         [  1 -1.1 ]                 [  1 -1.1 ]]
                   3



GETR     get a row from a matrix

         [[  1  2.3 ]
          [ -3  4.4 ]     --->       [  1  2.3 ]
          [  1 -1.1 ]]
                     1



GETC     get a column from a matrix

         [[  1  2.3 ]               [[  1 ]
          [ -3  4.4 ]     --->       [ -3 ]
          [  1 -1.1 ]]               [  1 ]]
                     1



DELR     delete a row from a matrix

         [[  1  2.3 ]
          [ -3  4.4 ]     --->   [[ -3  4.4 ]
          [  1 -1.1 ]]            [  1 -1.1 ]]
                     1



DELC     delete a collumn from a matrix

         [[  1  2.3 ]             [[  2.3 ]
          [ -3  4.4 ]     --->     [  4.4 ]
          [  1 -1.1 ]]             [ -1.1 ]]
                     1


PUTR     put a row to a matrix

         Inserts or overwrites a vector into a matrix as a row.
         A positive row-number indicates inserting, a negative overwriting.


         [[  1  2.3 ]             [[  0   0  ]
          [ -3  4.4 ]              [  1  2.3 ]
          [  1 -1.1 ]]    --->     [ -3  4.4 ]
                     1             [  1 -1.1 ]]
               [ 0 0 ]


         [[  1  2.3 ]             [[  0   0  ]
          [ -3  4.4 ]     --->     [ -3  4.4 ]
          [  1 -1.1 ]]             [  1 -1.1 ]]
                    -1
               [ 0 0 ]




PUTC     put a column to a matrix

         Inserts or overwrites a vector into a matrix as a column.
         A positive column-number indicates inserting, a negative overwriting.


         [[  1  2.3 ]            [[ 0  1  2.3 ]
          [ -3  4.4 ]     --->    [ 0 -3  4.4 ]
          [  1 -1.1 ]]            [ 0  1 -1.1 ]]
                     1
             [ 0 0 0 ]


         [[  1  2.3 ]             [[ 0   0  ]
          [ -3  4.4 ]     --->     [ 0  4.4 ]
          [  1 -1.1 ]]             [ 0 -1.1 ]]
                    -1
             [ 0 0 0 ]



 -----------------------------------------------------------------------------
| General Student Board | [e-mail]   | [e-mail]       |
| c/o Ulli Horlacher    | [e-mail] | 50184::asta  (DECnet/BelWUe) |
| University of Ulm     | ----------------------------------------------------|
| D-7900 Ulm, Germany   |        "Waiting for the prompt" -Marillion          |
 -----------------------------------------------------------------------------


%%HP: T(3)A(D)F(.);
DIR
  DELC
    \<< SWAP trn SWAP
DELR trn
    \>>
  DELR
    \<< \-> a
      \<< M\->V DUP a -
2 + ROLL DROP 1 -
V\->M
      \>>
    \>>
  PUTC
    \<< ROT trn ROT
ROT PUTR trn
    \>>
  PUTR
    \<< \-> a v
      \<< M\->V
        IF a 0 <
        THEN DUP a
+ 2 + ROLL DROP v
OVER a + 2 + ROLLD
        ELSE v OVER
a - 3 + ROLLD 1 +
        END V\->M
      \>>
    \>>
  V\->M
    \<< OVER SIZE 1
GET \-> n m
      \<< 0 n 1 -
        FOR i i m *
n i - + ROLL OBJ\->
DROP
        NEXT n m 2
\->LIST \->ARRY
      \>>
    \>>
  M\->V
    \<< OBJ\-> OBJ\->
DROP \-> n m
      \<< 1 n
        FOR i m 1
\->LIST \->ARRY n i - m
* i + ROLLD
        NEXT n
      \>>
    \>>
  GETR
    \<< \-> r
      \<< M\->V DUP r -
2 + PICK \-> a
        \<< DROPN a
        \>>
      \>>
    \>>
  GETC
    \<< SWAP TRN SWAP
GETR trn
    \>>
  CST { A\<-\->L trn
MOP V\<-\->M V\->M M\->V
GETR GETC PUTR PUTC
DELR DELC }
  A\<-\->L
    \<<
      IF DUP TYPE 5
==
      THEN
        IF DUP 1
GET TYPE 5 ==
        THEN \-> a
          \<< 1 a
SIZE
            FOR i a
i GET OBJ\-> 1 \->LIST
\->ARRY
            NEXT a
SIZE V\->M
          \>>
        ELSE OBJ\-> 1
\->LIST \->ARRY
        END
      ELSE
        IF DUP SIZE
SIZE 2 ==
        THEN M\->V {
} SWAP 1
          FOR i i 1
+ ROLL OBJ\-> 1 GET
\->LIST 1 \->LIST + -1
          STEP
        ELSE OBJ\-> 1
GET \->LIST
        END
      END
    \>>
  trn
    \<<
      IF DUP TYPE 5
==
      THEN
        IF DUP 1
GET TYPE 5 \=/
        THEN 1
\->LIST
        END DUP
SIZE OVER 1 GET
SIZE \-> l n m
        \<< 1 m
          FOR i 1 n
            FOR j l
j GET i GET
            NEXT n
\->LIST
          NEXT m
\->LIST
        \>>
        IF DUP SIZE
1 == OVER 1 GET
TYPE 5 == AND
        THEN OBJ\->
DROP
        END
      ELSE
        IF DUP SIZE
SIZE 1 ==
        THEN V\<-\->M
        END TRN
        IF DUP SIZE
1 GET 1 ==
        THEN V\<-\->M
        END
      END
    \>>
  MOP
    \<< 1 CF DEPTH
\->LIST DUP \-> s
      \<< LIST\-> DROP
\-> a o
        \<< a DUP
          IFERR RCL
1 SF SWAP DROP
          THEN
          END 1
OVER SIZE LIST\-> 1 -
          IF
          THEN *
          END
          IFERR
            FOR i
              IF 1
FS?
              THEN
a
              END i
OVER i GET 'X' STO
o EVAL
              IFERR
PUT
              THEN
ROT (1,0) * ROT ROT
PUT
              END
            NEXT
          THEN
DROP2 'X' PURGE
            IF 1
FS?
            THEN
STO
            ELSE
DROP
            END
CLEAR s LIST\-> DROP
"MOP Error:
" ERRM
+ DOERR
          ELSE
            IF 1
FC?
            THEN
SWAP
            END
DROP
          END 1 CF
'X' PURGE
        \>>
      \>>
    \>>
  V\<-\->M
    \<<
      IF DUP SIZE
SIZE 1 ==
      THEN 1 V\->M
      ELSE M\->V DROP
      END
    \>>
END